;;;; Copyright 2009 Peter von Etter

;;;; This file is part of Autoproject

;;;; Autoproject is free software: you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
;;;; License as published by the Free Software Foundation, either
;;;; version 3 of the License, or (at your option) any later version.
;;;;
;;;; Autoproject is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;;;; Lesser General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU Lesser General Public
;;;; License along with Autoproject.  If not, see
;;;; <http://www.gnu.org/licenses/>.

;; Code to make selecting stuff from a database easier.  

(in-package :autoproject.crud)

(deftype select () 'list)

(defparameter *select-amount* nil)

(defun format-maybe (format-string arg &optional (else ""))
  (if arg
      (format nil format-string arg)
      else))

(labels ((g (x)
           (format-list
            (mapcar (lambda (x) (f x #'g)) x)))
         (h (x)
           (format-list
            (mapcar (lambda (x) (f x #'h)) x) 
            :separator ") AND ("
            :start-with "(("
            :end-with "))"))
         (q (x)
           (format-list
            (mapcar (lambda (x) (f x #'h)) x) 
            :separator " join "))
         (k (x)
           (format-list
            (mapcar (lambda (x) (f x #'k)) x) 
            :separator ") OR ("
            :start-with "(("
            :end-with "))"))
         (f (x &optional (q #'g))
           (typecase x
             (null nil)
             (string x)
             (symbol (sqlify x))
             (list (funcall q x)))))

  (defun sql-select (&key (attr "*") table where join
                     group-by order-by having amount
                     offset)
    (declare ((or list symbol string) attr table group-by order-by)
             ((or list string) where having join)
             ((or null integer (member no-limit))
              amount offset))

    (assert table)
    (assert attr)
            
    (format nil "select ~A from ~A~A~A~A~A~A~A~A"
            (f attr) 
            (f table)
            (format-maybe " where ~A" (f where #'h))
            (format-maybe " join ~A" (f join #'q))
            (format-maybe " group by ~A" (f group-by))
            (format-maybe " having ~A" (f having))
            (format-maybe " order by ~A" (f order-by))
            (format-maybe " limit ~A" amount)
            (format-maybe " offset ~A" offset)))

  (defun sql-or (&rest args)
    (k args))

  (defun sql-and (&rest args)
    (h args))

  (defun sql-op (left op right)
    (format nil "~A ~A ~A" left op right))

  (defun sql-quote (value)
    (database-format-value value)))

(defun merge-select (select defaults)
  (merge-plist select defaults))

(defun make-select (&key (attr "*") table where group-by join
                    order-by having amount offset)
  ;; (assert (<= 0 amount))
  ;; (assert (<= 0 offset))
  (list :attr attr
        :table table
        :join join
        :where where
        :group-by group-by
        :order-by order-by
        :having having
        :amount (or amount *select-amount*)
        :offset (or offset (when amount 0))))

(defun apply-select (select)
  (apply #'sql-select select))

(defun get-select-property (select property)
  (getf select property))
  
(defun set-select-property (select property value)
  (setf (getf select property) value))

;;;;;;;


(flet ((f (select op)
         (let ((s (merge-select 
                   (make-select 
                    :offset (funcall op (get-select-property select :offset)
                                     (get-select-property select :amount)))
                   select)))
           (assert (<= 0 (get-select-property s :offset)))
           s)))
  
  (defun select-next-page (select)
    (f select #'+))
  
  (defun select-previous-page (select)
    (f select #'-)))
  
(defun select-page (select page)
  (merge-select 
   (make-select :offset (* page (get-select-property select :amount)))
   select))

(defun select-count (select)
  (>> (merge-select (make-select :attr "count(*)" 
                                 :amount 'no-limit)
                    select)
      (progn 
        (remf it :offset)
        (remf it :order-by)
        it)))

